The Atari Compendium/The Atari Compendium (Toad Computers) (1994).iso/files/umich/utils/viewers/streader.lzh/STREADER.LST

File List | 1990-05-11 | 80KB | 2,455 lines

' ****************************************************************************
' *                                                                          *
' *                             S T  R E A D E R                             *
' *                               Version 3.10                               *
' *                                                                          *
' *                               Program Code                               *
' *               © 1990 By Sterling K. Webb, SKWare One, Inc.               *
' *                   P. O. Box 277, Bunker Hill, IL 62014                   *
' *                                                                          *
' *                       GFA BASIC © GFA SYSTEMTECHNIK                      *
' *                                                                          *
' *                                                                          *
' ****************************************************************************
'
'
' ****************************************************************************
' *                        ST READER PROGRAM FUNCTIONS                       *
' ****************************************************************************
'
'   * 80-column display in all three ST resolutions (yes, even in low!)
'
'   * text display in either system font on either monitor.
'     (25 or 50 lines in mono; 25 or 12 lines in color)
'
'   * text display in DEGAS-format fonts (like TEMPUS), but
'     with up to ten loaded fonts on-line at one time.
'
'   * converts 1stWord files to Ascii text and Ascii to 1stWord.
'
'   * fast forward and reverse search with querry.
'
'   * print or save a file or any portion of a file.
'
'   * screen text windows (looks a lot like EMACS): open two windows
'     on a single document with independent scrolling, search, etc.
'
'   * can be installed with text filetypes as applications (runs
'     automatically when an installed filetype is double-clicked).
'
'   * fast, flickerless screen updating.
'
'   * extensively annotated program text, contains modifiable routines
'     that can be used to install custom fonts in your own programs,
'     allow you to implement text windows, play with the Line A Tables
'     (bombs away!), talk to your shifter chip, find the Line A address
'     (even in GFA Basic 2)!
'
'   * runs under GFA Basic version 2.0, 3.0, 3.07 with GFA3 compiled
'     version provided.
'
'   * tested on 1040ST, Mega4, with old ROM's, with intermediate ROM's, and
'     with Rainbow TOS version 1.4 (PS: it works on all of them!)
'
'   * placed in Public Domain June 1, 1990, with the customary dis-
'     claimers about its use, suitability, applicability, worthiness,
'     and ancestry, without any warranty express or implied... and so
'     forth.
'
' ****************************************************************************
' *                    SECTION 0: PROGRAM INITIALIZATION                     *
' ****************************************************************************
'
' first off, gather the user resolution
Rez%=Xbios(4)
' save it under another name, so we can restore it
' if we change resolutions, which we just might do
Original_rez%=Rez%
' save the user's palette
@Palette_saver
' save the user's drive selection
Use_drive%=Gemdos(25)+1
' if user in low rez, switch him to medium
If Rez%=0
  Void Xbios(5,L:-1,L:-1,1)
Endif
' gather the current operating resolution
Rez%=Xbios(4)
' calculate the y-coordinate of the bottom_line
Bline%=199+((Rez%-1)*200)
' calculate the desktop fill appropriate to the resolution
Let Fill%=8\Rez%
' define the program palette
C0%=&H777
C3%=&H0
C1%=&H770
C2%=&H70
' set the program palette
Setcolor 0,C0%
Setcolor 1,C1%
Setcolor 2,C2%
Setcolor 3,C3%
' define those neat little arrows as charatcers because...
' GFA 3.07 WILL NOT LOAD a .LST file containing a printed Chr$(3)!
C1$=Chr$(1)
C2$=Chr$(2)
C3$=Chr$(3)
C4$=Chr$(4)
' this SBR works in GFA Version 2 and could be adapted to any language
@Find_linea_address
' name these address locations in the Line A Variable Tables:
' these are the addresses used by the GFA PRINT command, not by
' the TEXT command or by GEM itself.
'
' pointer to the location of the font data (character set)
Font_data_adr%=Line_a_adr%-22
' this one is really neat:
' the address of an offset read by the shifter chip itself
' it works like this: if you stuck 16000 in this address,
' the shifter chip would leave the first 16000 bytes of
' screen memory alone and start screen operations halfway
' down the physical monitor screen. Hmmm... that's clipping!
Shifter_adr%=Line_a_adr%-30
' stores the number of bytes in a single print line, i.e.,
' how far through the screen memory the console driver advances
' for the next print line when a linefeed is received or forced
Ram_line_adr%=Line_a_adr%-40
' the maximum number of print lines on a screen minus one
' (lines are numbered from zero)
Max_line_adr%=Line_a_adr%-42
' where the console driver reads height of the character cell in scan lines
Cell_height_adr%=Line_a_adr%-46
' set up tables to hold these values for each of a total of twelve fonts
Dim Font_data_address%(12)
Dim Cell_height%(12)
Dim Max_line%(12)
Dim Ram_line%(12)
Dim Font_size%(12)
' this SBR creates the above Table Values for the two System Fonts
@Font_fitter
' checks for size of effective screen in bytes
@Check_screen(Font%)
' we'll begin in the usual native-to-the-resolution system font
Nonsystem_text_flag!=False
' the ten fonts refer to loadable Degas-format fonts
' the "+2" you see in the indices is because loaded fonts
' are in addition to the two system fonts already available
Dim Font$(10)
' initially, we'll fill all the fonts with copies of the
' current system font, so that after we load in the 128
' characters of a Degas font, we'll still have the upper
' half of the ST's 256 characters... We'll have to do this
' again later, so we'll have both 8-high and 16-high fonts
' with the right back end characters... Somehow I feel safer with'em full
For I%=0 To 9
  Font$(I%)=String$(4096,0)
  Bmove Font_data_address%(1),Varptr(Font$(I%)),4096
  ' initialize these values for the system fonts:
  ' cell_height = the height of the character cell in scan lines
  If Rez%=2
    Cell_height%(I%+2)=16
  Else
    Cell_height%(I%+2)=8
  Endif
  ' max_line = the highest numbered print line possible on a screen
  ' (lines are numbered from 0)
  Max_line%(I%+2)=24
  ' ram_line = the size in bytes of one print line in screen memory
  Ram_line%(I%+2)=1280
  ' a marker for native=0 or non-native=1 fonts (relative to rez)
  Font_size%(I%+2)=0
Next I%
' it's IMPORTANT to exit through the close_out routine,
' so as to reset resolution, fonts, shifter chip, if required.
On error gosub End
' table for window parameters:
' the starting point of the window on the screen...
Dim Windtop%(2)
' ...and the height of the window in print lines
Dim Windhi%(2)
' initial window set up
@Set_windows
' we also need a pointer to where we are in the document for each window
Dim Windex%(2)
' ...and the flag set to show we do not have multiple windows at startup
Windows!=False
' an empty string used to wipe a windowed area clean
Let Eraser$=String$(32000,0)
' we also need an off-screen printing area allocated in memory
Offscreen$=String$(32255,0)
' this is the number of menu lines for the bottom of the screen ledger_line
M_num%=12
' here they are...
Dim T$(M_num%)
T$(0)=" ST READER by SKWare One © 1990 by S. K. Webb     <Esc> <Tab> shifts Menu Line. "
T$(1)=" Page:"+C2$+"  Page:"+C1$+"  Line Up:"+C4$+"  Line Down:"+C3$+" Start:<Home> End:CTRL+<Home> Quit:<Undo>"
T$(2)=" ½Page:CNTL+"+C4$+"  ½Page:CNTL+"+C3$+"  Numbers 1 to 9:Repeat Last Screen Command n Times  "
T$(3)=" Convert "+C3$+" Ascii:<Help>   "+C3$+" 1stWord:CNTL+<Help>  Save:CNTL+<S>   Print:CNTL+<P> "
T$(4)=" Mark Up:CNTL+<U>  Mark Down:CNTL+<D>  Block Start:CNTL+<A>  Block End:CNTL+<Z> "
T$(5)=" Reset Drive:CNTL+<R>    Clean Up Screen Display:CNTL+<C>   Strip Tabs:CNTL+<T> "
T$(6)=" Toggle Screen Black/White:CNTL+<B>     Toggle Text Size [SYSTEM FONT]:CNTL+<X> "
T$(7)=" Toggle to AltFont:CNTL+<F>  Load New Font:CNTL+<N>  Exchange AltFonts:FuncKeys "
T$(8)=" Search with Querry:CNTL+<Q>    Reverse Search:ALT+<Q>   Show Position:CNTL+<=> "
T$(9)=" Increase Margin:CNTL+<M>   Decrease Margin:ALT+<M>  Toggle View Style:CNTL+<V> "
T$(10)=" Open/Toggle Window:CNTL+<W> Shrink Window:<-> Grow Window:<+> Unwindow:ALT+<W> "
T$(11)="    Special Thanks to Eastside Atari Users' Group; Alton, IL and Metro East     "
' console code for inverse print
Inv$=Chr$(27)+"p"
' console code for normal print
Norm$=Chr$(27)+"q"
' console code for automatic character wrap
Over_flow$=Chr$(27)+"v"
' console code for no automatic character wrap
No_flow$=Chr$(27)+"w"
' turn off the automatic character wrap
Print No_flow$;
' a string of spaces to hold the command tail out of the basepage
Tail_length%=Peek(Basepage+128)
If Tail_length%>0
  Command_line$=String$(Tail_length%,32)
  ' fill the empty string to see if a document filetype has been clicked on
  Bmove Basepage+129,Varptr(Command_line$),Tail_length%
Else
  Command_line$=""
  Trick!=True
  @Drive
  @Tidy
Endif
Trick!=False
' Gee, why does all this remind me of CP/M and the CCP?
'
' ****************************************************************************
' *                             SECTION 1: MAIN                              *
' ****************************************************************************
'
' label for a constructed loop
Luper:
' set tab at zero
Clr Tb%
Tabs!=False
' if not called by an installed application (document filetype),
' have the user select his own file to read
If Len(Command_line$)<2 Or Kexit%>0
  Fileselect Path$,"",File$
  If Len(File$)=0
    If Kexit%>0
      @Alert(2,"  |Do You Wish to Exit|      to GEM?   |  ",2," No | Yes ",Dummie%)
      If Dummie%=1
        Clr Kexit%
        Clr C%
        Clr Cc%
        Goto Lupey
      Else
        @End
      Endif
    Else
      @End
    Endif
  Endif
  Command_line$=""
  Erase Type$()
  Index%=1
Else
  File$=Command_line$
Endif
' clear the KEY EXIT flag
Clr Kexit%
' wait for the clicks to die down...
Repeat
Until Mousek=0
' strip the leading root symbol "\" for printing
If Asc(File$)=92
  P_file$=Right$(File$,Len(File$)-1)
Else
  P_file$=File$
Endif
' dump the rodent
Hidem
' divide the free memory into two equal halves
Fr%=Fre(0)-10000
S%=Fr%\2
' calculate maximum number of full ascii strings it can hold
Ts%=(S%\82)+1
Ar$=Str$(S%)
' set up dimensioned strings to hold the lines of the text file
Dim Type$(Ts%)
' define a carriage return
Cr$=Chr$(13)+Chr$(10)
' pad the type strings
F$=String$(82,32)
For I%=1 To Ts%-1
  Type$(I%)=F$
Next I%
' open the file and measure its length
Open "I",#1,File$
Ex%=Lof(#1)
' suck in a test string to guage what kind of file it is
If Ex%>255
  Test$=Input$(255,#1)
Else
  Test$=Input$(Ex%,#1)
Endif
Close #1
' look for a carriage return in the test string
X0%=Instr(Test$,Cr$)
Test$=""
' some kinds of files we can't or don't want to load
If Ex%>S%
  @Too_long_abort
Endif
If X0%=0
  @Non_text_abort
Endif
If X0%>242
  @Long_line_abort
Endif
If Kexit%>0
  Goto File_check
Endif
' establish a dummie array to serve as a reserved memory buffer
Dim T%((Ex%\4)+1)
' set up a loading screen display that looks sort of like a desktop
@Tidy                     ! this is just our old friend CLearScreen
If (Rez%=2 And Font_size%(Font%)=1) Or (Rez%=1 And Font_size%(Font%)=0)
  Bound%=17
Else
  Bound%=32
Endif
' remove the line boundary from filled figures
' (identical to GFA3's BOUNDARY 0 command)
Dpoke Contrl,104
Dpoke Contrl+6,1
Dpoke Intin,0
Vdisys
' clear the top of the display screen
Deffill 0,2,8
Pbox 0,Bound%,639,Bline%
' fake a desktop-look
Deffill 3,2,Fill%
Pbox 0,Bound%,639,Bline%
' if we were originally in low rez, the pbox will
' only cover half the screen, so we copy it to the right side...
If Original_rez%=0
  Get 1,Bound%,319,Bline%,Desk$
  Vsync
  Put 320,Bound%,Desk$
  Desk$=""
Endif
' switch to system font
@Font_check_in
' print the header
Print Inv$;
Print At(1,1);"                 ST READER by S. K. Webb and SKWare One  © 1990                        ";
Print Norm$;
Print At(1,2);
@Clear
Print " LOADING   ";P_file$;"   Length of File: ";Str$(Ex%);" Bytes";
' load the file
Bload File$,Varptr(T%(0))
Print At(1,2);
@Clear
' if compiled in GFA2:
' Print " ";P_file$;" LOADed. FORMAT requires ";Left$(Str$(Ex%/7565),6);" seconds for ";Str$(Ex%);" bytes.";
' if compiled in GFA3:
Print " ";P_file$;" LOADed. FORMAT requires ";Left$(Str$(Ex%/24992),6);" seconds for ";Str$(Ex%);" bytes.";
' compiled in GFA2, it formats 7565 characters per second
' for maximum speed in GFA3 compilation, replace PEEK() with BYTE{}
' (it's faster in GFA3, formatting at 24992 characters per second!)
' or you could replace the whole thing with GFA3's RECALL command
' (however, RECALL strips the carriage returns from strings, and it
' makes no provision for dealing with long lines... That's up to you.)
'
' here's the actual formatting routine:
'
N%=1       ! the index of the type string
I%=0       ! pointer to our position in the filedata
Li%=I%     ! pointer to the pointer position after the last completed line
Repeat
  Repeat
    ' seek through the data for a linefeed. (If the text does not use
    ' the chr$(13)+chr$(10) combination, this may have to be modified...)
    A%=Peek(Varptr(T%(0))+I%)
    Inc I%
  Until A%=10 Or I%=Ex%
  ' if the line is less than 80 characters plus carriage return/linefeed
  ' move it to the type string indexed by N%
  If I%-Li%=<82
    Bmove Varptr(T%(0))+Li%,Varptr(Type$(N%)),I%-Li%
  Else
    ' if the lines are longer, we break them up...
    While I%-Li%>82
      Bmove Varptr(T%(0))+Li%,Varptr(Type$(N%)),80
      Type$(N%)=Left$(Type$(N%),80)+Cr$
      Li%=Li%+80
      Inc N%
    Wend
    Bmove Varptr(T%(0))+Li%,Varptr(Type$(N%)),I%-Li%
  Endif
  ' truncate the type string if needed
  Type$(N%)=Left$(Type$(N%),I%-Li%)
  ' update the back pointer
  Li%=I%
  ' update the type string index
  Inc N%
Until I%=Ex% Or N%=Ts%-1
' the "top" is the number_of_type$
Top%=N%
' get rid the fake desktop display
@Tidy
' dump the loading array and empty the unused type strings
Erase T%()
For I%=Top%+1 To Ts%-1
  Type$(I%)=""
Next I%
' we start with the first line of the file
Index%=1
' a positive heading means to display the file from first to last
' a negative heading means to display the file from last to first
Heading%=1
' prints the menu line
@Ledger_line
Lupey:
' prints the screen
@Screen_print
' look for user input
@Key
' this is the bottom of the constructed loop
File_check:
@Alert(2,"  |Do You Wish to Read|   Another File?|  ",1," No | Yes ",Dummie%)
' we can go around again...
If Dummie%=2
  Goto Luper
Endif
If Dummie%=1
  @Alert(2,"  |Do You Wish to Exit|      to GEM?   |  ",2," No | Yes ",Dummie%)
  If Dummie%=1
    Clr Kexit%
    Clr C%
    Clr Cc%
    Goto Lupey
  Else
    @End
  Endif
Endif
' ...or we can quit (we never get here, but I have a neatness compulsion)
@End
'
' ****************************************************************************
' *                          SECTION 2: KEY READERS                           *
' ****************************************************************************
'
Procedure Key
  Repeat
    C$=Inkey$
    ' code one-byte keys as C%, two-byte keys as Cc%
    ' CNTL+Key returns one-byte codes: CNTL+A=1, CNTL+B=2, CNTL+C=3, etc.
    ' ALT+Key returns two-byte codes based on key-position on the keyboard
    If Len(C$)=2
      Cc%=Asc(Right$(C$))
      If Cc%=98
        ' check for CNTL+<Help> key combination
        Dpoke Contrl,128
        Vdisys
        Flag%=Dpeek(Intout)
      Endif
    Endif
    If Len(C$)=1
      C%=Asc(C$)
    Endif
    ' CNTL+B = toggle background color
    If C%=2
      If Black_flag%=0
        Setcolor 0,C3%
        Setcolor 3,C0%
        Black_flag%=1
      Else
        Setcolor 0,C0%
        Setcolor 3,C3%
        Clr Black_flag%
      Endif
    Endif
    ' these following commands valid when only one window is present
    If Windows!=False
      ' CNTL+C = reprint the screen
      If C%=3
        @Clean_up
      Endif
      ' CNTL+F = toggle to/from AltFont
      If C%=6
        If Nonsystem_text_flag!=False
          ' if no loaded AltFont, load one
          If Alt_font_flag%=0
            @Degas_loader
            @Font_checker
          Else
            ' switch to last selected AltFont
            Nonsystem_text_flag!=True
            Font%=Alt_font%
            @Tidy
            @Initialize_font(Font%)
          Endif
        Else
          ' else switch back to last selected system font
          Nonsystem_text_flag!=False
          Font%=Standing_font%
          @Tidy
          @Initialize_font(Font%)
        Endif
        @Clean_up
      Endif
      ' CNTL+M = increase screen margin
      ' NOTE: <Return> also passes a chr$(13) to the console
      ' and will shift the margins...
      If C%=13
        ' margin must be in units = Bitplane Words
        ' otherwise, you will split up the planes
        Add Margin%,2*Dpeek(Line_a_adr%)
        Margin%=Margin% Mod Dpeek(Line_a_adr%-2)
        @Margin
      Endif
      ' CNTL+N = load a new AltFont and install it
      If C%=14
        @Degas_loader
        @Font_checker
        @Clean_up
      Endif
      ' CNTL+P = print the document (or block)
      If C%=16
        @Print
      Endif
      ' CNTL+R = Reset the Current Drive
      If C%=18
        @Drive
        @Ledger_line
      Endif
      ' CNTL+S = save the document (or block)
      If C%=19
        @Save
      Endif
      ' CNTL+T = strip tabs
      If C%=20
        @Tabber
      Endif
      ' CNTL+V = toggle between visible and invisible printing
      If C%=22
        View%=1-View%
      Endif
      ' CNTL+X = toggle between the two system fonts
      If C%=24
        If Font%<2
          Font%=1-Font%
          Standing_font%=Font%
          @Tidy
          @Initialize_font(Font%)
          @Clean_up
        Else
          Print Chr$(7);
        Endif
      Endif
      ' <Esc> = advance to display of next menu line
      If C%=27
        Add Which%,1
        Which%=Which% Mod M_num%
        @Ledger_line
      Endif
      ' <Tab> = retreat to display of previous menu line
      If C%=9
        Sub Which%,1
        If Which%<0
          Which%=M_num%-1
        Endif
        Which%=Which% Mod M_num%
        @Ledger_line
      Endif
      ' CNTL+<=> = show location-in-document of the top screen line
      If C%=29
        @Data_line
        @Little_key_reader
        @Ledger_line
      Endif
      ' number key used for multiple page or line advances or retreats
      If C%>48 And C%<58
        Index%=Index%+(Jmp%*(C%-48)*Heading%)
        @Screen_print
      Endif
      ' ALT+M = decrease screen margin
      If Cc%=50
        ' margin must be in units = Bitplane Words
        ' otherwise, you will split up the planes
        Sub Margin%,2*Dpeek(Line_a_adr%)
        Margin%=Margin% Mod Dpeek(Line_a_adr%-2)
        @Margin
      Endif
      ' little SBR to check for cursor keypad commands
      ' (double_key is used by other routines than this one)
      @Double_key
      ' FuncKeys assigned to up to ten AltFonts
      ' you could, I suppose, have twenty fonts loaded using
      ' the shifted FuncKeys, but what do you need twenty fonts for...?
      If Cc%>58 And Cc%<69
        If Nonsystem_text_flag!=True
          Font%=Cc%-57
          If Font%<Hi_font%+2
            @Tidy
            @Initialize_font(Font%)
            @Clean_up
          Else
            Print Chr$(7);
          Endif
        Else
          Print Chr$(7);
        Endif
      Endif
      ' <Undo> = Kexit% = KEY EXIT
      If Cc%=97
        Kexit%=1
      Endif
      ' <Help> = convert document type (1stWord<==>Ascii)
      If Cc%=98
        @Convert
      Endif
    Endif
    ' CNTL+Q = Search forward
    If C%=17
      Searches%=0
      @Search
    Endif
    ' ALT+Q = Search backward
    If Cc%=16
      Searches%=-1
      @Search
    Endif
    '  CNTL+W = open a second window or, if open, toggle between windows
    If C%=23
      ' open a second window
      If Windows!=False
        Which%=10
        @Ledger_line
        Windows!=True
        Window%=1
        Active_window%=Window%
        @Set_up_windows
      Else
        ' switch active windows
        Active_window%=1-Window%
        @Window(Window%,Windex%(Window%))
        Window%=Active_window%
        @Window(Window%,Windex%(Window%))
      Endif
    Endif
    ' all these commands effective only if two windows are open
    If Windows!=True
      ' ALT+W = unwindow (close the non-active window)
      If Cc%=17
        @Unwindow
      Endif
      ' <Undo> = KEY EXIT
      If Cc%=97
        @Unwindow
        Kexit%=1
      Endif
      ' cursor keys: document move in windows
      ' functionally equivalent to Double_key SBR
      If Cc%=80
        Heading%=1
        Jmp%=Dpeek(Max_line_adr%)
        Windex%(Window%)=Windex%(Window%)+Jmp%
        @Window(Window%,Windex%(Window%))
      Endif
      If Cc%=72
        Heading%=-1
        Jmp%=Dpeek(Max_line_adr%)
        Windex%(Window%)=Windex%(Window%)-Jmp%
        @Window(Window%,Windex%(Window%))
      Endif
      If Cc%=77
        Heading%=1
        Jmp%=1
        Windex%(Window%)=Windex%(Window%)+Jmp%
        @Window(Window%,Windex%(Window%))
      Endif
      If Cc%=75
        Heading%=-1
        Jmp%=1
        Windex%(Window%)=Windex%(Window%)-Jmp%
        @Window(Window%,Windex%(Window%))
      Endif
      If Cc%=71
        Heading%=1
        Jmp%=Dpeek(Max_line_adr%)
        Windex%(Window%)=0
        @Window(Window%,Windex%(Window%))
      Endif
      If Cc%=119
        Heading%=-1
        Jmp%=Dpeek(Max_line_adr%)
        Windex%(Window%)=Top%-Jmp%
        @Window(Window%,Windex%(Window%))
      Endif
      ' <-> or <+> re-size windows
      ' more headaches than any other piece of this code:
      ' (or maybe I just had a headache that day, doanno)
      ' re-sizing the screen windows involves both windows
      ' since to shrink one is the grow the other, and vice versa
      ' window 1 is the top window; window 0 is the bottom window
      If (Window%=0 And C%=43) Or (Window%=1 And C%=45)
        If Windhi%(1)>1
          ' clear the ledger_line of top window
          Dpoke Max_line_adr%,Windhi%(1)+1
          Dpoke Shifter_adr%,Windtop%(1)
          Print At(1,Windhi%(1)+1);
          @Clear
          ' increase the size of the bottom window
          Dpoke Max_line_adr%,Windhi%(0)+1
          Dpoke Shifter_adr%,Windtop%(0)
          Sub Windtop%(0),Ram_line%(Font%)
          @Clear_window(0)
          Add Windhi%(0),1
          Dpoke Max_line_adr%,Windhi%(0)+1
          Dpoke Shifter_adr%,Windtop%(0)
          ' reprint the bottom window
          @Window(0,Windex%(0))
          ' shrink the top window parameters...
          Dpoke Max_line_adr%,Windhi%(1)+1
          Dpoke Shifter_adr%,Windtop%(1)
          @Clear_window(1)
          Sub Windhi%(1),1
          ' ... and re-print it
          @Window(1,Windex%(1))
          ' note that the number of window lines (Windhi) has to be
          ' temporarily increased by one to erase the window ledger_line along
          ' with the window itself in each case
        Endif
      Endif
      ' this is a little easier...
      If (Window%=1 And C%=43) Or (Window%=0 And C%=45)
        If Windhi%(0)>1
          Dpoke Shifter_adr%,Windtop%(1)
          Add Windhi%(1),1
          Dpoke Max_line_adr%,Windhi%(1)+1
          @Clear_window(1)
          @Window(1,Windex%(1))
          Add Windtop%(0),Ram_line%(Font%)
          Dpoke Shifter_adr%,Windtop%(0)
          Dpoke Max_line_adr%,Windhi%(0)
          @Clear_window(0)
          Sub Windhi%(0),1
          Dpoke Max_line_adr%,Windhi%(0)+1
          @Window(0,Windex%(0))
        Endif
      Endif
    Endif
    ' clear these values to avoid endless repetition
    Clr Cc%
    Clr C%
    Clr Flag%
  Until Kexit%>0
Return
Procedure Double_key
  Clr Offset%
  Stoff%=Index%
  If Cc%=75
    Heading%=-1
    Jmp%=1
    Index%=Index%-Jmp%
    If Index%<1
      Index%=1
      @Screen_print
    Else
      ' the BMOVE command shifts the screen down one line...
      Bmove Xbios(2),Xbios(2)+Ram_line%(Font%),Affected_screen%
      @Home
      @Clear
      ' ...and print a new top print line
      Print Type$(Index%);
    Endif
  Endif
  If Cc%=77
    ' used by other SBR's, but it's the inverse of the above:
    ' shifts the screen up one line and prints new bottom line
    @Bumper
  Endif
  If Cc%=80
    Heading%=1
    Jmp%=Max_line%(Font%)-1
    Index%=Index%+Jmp%
    @Screen_print
  Endif
  If Cc%=72
    Heading%=-1
    Jmp%=Max_line%(Font%)-1
    Index%=Index%-Jmp%
    @Screen_print
  Endif
  If Cc%=71
    Heading%=1
    Jmp%=Max_line%(Font%)-1
    Index%=1
    @Screen_print
  Endif
  If Cc%=119
    Heading%=-1
    Jmp%=Max_line%(Font%)-1
    Index%=Top%-Max_line%(Font%)+1
    @Screen_print
    Print At(1,Max_line%(Font%));
    @Clear
  Endif
  If Cc%=115
    Heading%=-1
    Jmp%=12
    Index%=Index%-12
    @Screen_print
  Endif
  If Cc%=116
    Heading%=1
    Jmp%=12
    Index%=Index%+12
    @Screen_print
  Endif
  Offset%=Index%-Stoff%
Return
Procedure Bumper
  Heading%=1
  Jmp%=1
  Index%=Index%+Jmp%
  If Index%>Top%-Max_line%(Font%)+1
    Index%=Top%-Max_line%(Font%)+1
    @Screen_print
    @Ledger_line
  Else
    Bmove Xbios(2)+Ram_line%(Font%),Xbios(2),Affected_screen%
    ' locate at last line, clear it, print new last line
    Print At(1,Max_line%(Font%));Chr$(27);"K";Type$(Index%+Max_line%(Font%)-1);
  Endif
Return
'
' ****************************************************************************
' *                          SECTION 3: SCREEN ROUTINES                      *
' ****************************************************************************
'
Procedure Tidy
  Cls
  ' boy! that was easy
Return
' sets up the visible and invisible screens:
' the visible screen is the monitor screen and/or its memory image
' the invisible screen is a screen sized area of memory beginning on
' an even-256-byte boundary. All screen printing is done to the logical
' screen. To print invisibly, define the off_screen area as the logical
' screen. Use Xbios(5,L:logical_screen_address,L:physical_screen_address,-1)
' then, print to the "invisible" logical screen. Repeat the Xbios 5 call
' to swap the screens back again (to the "visible" screen). Then, either
' BMOVE the "invisible" screen to the "visible" screen or use GET (before
' switching back) and PUT (after switching back) to transfer the screen.
Procedure Set_up
  Physical%=Xbios(2)
  Logical%=Xbios(3)
  Page1%=Physical%
  Page2%=Varptr(Offscreen$)+255 And &HFFFFFF00
Return
Procedure Screen_print
  If View%=0
    @Set_up
    ' moves what's on the monitor to the off_screen memory area
    Bmove Page1%,Page2%,32000
    ' prints to the off_screem memory, leaving
    ' the old logical screen on the monitor
    Void Xbios(5,L:Page2%,L:Logical%,-1)
  Endif
  T%=Max_line%(Font%)
  ' clears the screen but leaves the cursor at the end of the printing area
  ' (this saves the menu ledger_line from being cleared)
  Print At(80,T%);Chr$(27);"d";
  ' bring it back home
  @Home
  ' check the indices on the type strings
  ' (you guessed it right: he must be a physicist,
  ' because he has to check the boundary conditions...)
  @Check
  ' now we can print the strings...
  If T%-1+Index%=>Top%
    I%=0+Index%
    Repeat
      Print Type$(I%);
      Inc I%
    Until I%>Top%
  Else
    I%=0+Index%
    Repeat
      Print Type$(I%);
      Inc I%
    Until I%=>T%+Index%
  Endif
  If View%=0
    ' first, capture from the off_screen screen...
    Sget Patch$
    ' ...then, return the monitor to the usual configuration...
    Void Xbios(5,L:Logical%,L:Page1%,-1)
    ' wait... wait... wait...
    Vsync
    ' ...then slap the off_screen patch on the monitor.
    Sput Patch$
    ' garbage collection (more neatness) but probably slows it down a little
    Patch$=""
  Endif
Return
Procedure Check
  If Index%>Top%-Max_line%(Font%)+1
    Index%=Top%-Max_line%(Font%)+1
  Endif
  If Index%<1
    Index%=1
  Endif
Return
' prints the menu ledger_line
Procedure Ledger_line
  ' switch to system font
  @Font_check_in
  ' locate, switch to inverse video
  @Message(Inv$)
  ' the "5" parameter forces the console driver to print all characters as
  ' characters; none are intrepreted as console codes, giving full access
  ' to all 256 characters of the ST's ascii set. Very handy...
  For Z%=1 To Len(T$(Which%))
    Void Bios(3,5,Asc(Mid$(T$(Which%),Z%,1)))
  Next Z%
  ' switch to normal video output
  Print Norm$;
  ' return to text printing font
  @Font_check_out
Return
' these two SBR must be used in pairs
Procedure Font_check_in
  ' eliminate any screen margin
  Dpoke Shifter_adr%,0
  ' if an AltFont, select for appropriate system font
  If Font%>1
    Lpoke Font_data_adr%,Font_data_address%(1-Font_size%(Font%))
  Endif
Return
Procedure Font_check_out
  ' restore AltFont
  If Font%>1
    Lpoke Font_data_adr%,Font_data_address%(Font%)
  Endif
  ' restore screen margin, if any
  Dpoke Shifter_adr%,Margin%
Return
' shifts the screen margin
Procedure Margin
  ' margin must be in units = Bitplane Words
  ' otherwise, you will split up the planes
  Dpoke Shifter_adr%,Margin%
  @Screen_print
Return
Procedure Clean_up
  @Screen_print
  @Ledger_line
Return
' console code to home the cursor without erasing the screen
Procedure Home
  Print Chr$(27);"H";
Return
' console code to clear a line from the cursor position to end
Procedure Clear
  Print Chr$(27);"K";
Return
' when using a 16-pixel-high font on color monitor, we have 12-1/2 lines,
' except that the half-line looks silly, so we shorten the size of the screen
Procedure Check_screen(Z%)
  If Max_line%(Z%)=11
    Affected_screen%=(Max_line%(Z%)-1)*Ram_line%(Z%)
  Else
    Affected_screen%=32000-Ram_line%(Z%)*2
  Endif
Return
'
' ****************************************************************************
' *                            SECTION 4: FONT ROUTINES                      *
' ****************************************************************************
'
Procedure Find_linea_address
  ' start in the lower memory; this ought to be low enough
  I%=&H28FE
  Repeat
    ' increment by words
    Add I%,2
    ' GEM is sluggish about updating the Line A Tables, so...
    ' Hit him TWICE
    Graphmode 2
    Graphmode 2
    First%=Dpeek(I%)
    ' Hit him TWICE
    Graphmode 3
    Graphmode 3
    Second%=Dpeek(I%)
    ' Hit him TWICE
    Graphmode 4
    Graphmode 4
    Third%=Dpeek(I%)
    ' this just to reset the write mode
    Graphmode 1
    Graphmode 1
    ' until you find a match
  Until First%=1 And Second%=2 And Third%=3
  ' if a memory location changes with the write mode, then it's
  ' the location 36 bytes above the Line A Table Address!
  ' Ok, so it's crude... but it WORKS!
  Let Line_a_adr%=I%-36
  ' there's more than one way to skin a Line_a_address
  ' in GFA3: Line_a_adr%=L~a     ! Gee, that was easy!
Return
Procedure Font_checker
  ' only do it if the attempt to load a font file was successful
  If Filegot%=1
    @Tidy
    @Initialize_font(Font%)
    ' sets the flags for AltFont
    Nonsystem_text_flag!=True
    If Alt_font_flag%=0
      Alt_font_flag%=1
    Endif
  Endif
Return
Procedure Font_fitter
  ' the table of font header addresses (at 444, 448, 452, 456 bytes below
  ' Line-A), are initialized differently on the two system monitors,
  ' so a slightly different routine is needed to find the address of the
  ' the other system font on each monitor system. Two of these four table
  ' address slots are going to be empty (one is for a GEM-loaded GDOS font,
  ' and one is always empty to show that it's always empty!
  ' This type of logic is called "GEM-THINK")
  If Rez%=2
    Dim Font_header%(4)
    For I%=0 To 3
      Font_header%(I%)=Lpeek(Line_a_adr%-456+I%*4)
      ' the Icon font header remains in ROM; we're looking for the one
      ' that has a "shadow" or image placed somewhere below the basepage
      ' also, we're looking for a different font than the one currently
      ' initialized by GEM (current font header address is tabled
      ' 460 bytes below Line_a, just below the table of four font header
      ' addresses at 444, 448, 452, and 456 bytes below the Line-A address)
      ' and, of course, we don't want one of the empty GDOS slots...
      ' so that's why all the IFfies...
      If Font_header%(I%)<>0 And Font_header%(I%)<Basepage And Font_header%(I%)<>Lpeek(Line_a_adr%-460)
        Let Next_font_header_adr%=Font_header%(I%)
      Endif
    Next I%
    This_font_header_adr%=Lpeek(Line_a_adr%-460)
    Other_font_data_address%=Lpeek(Next_font_header_adr%+76)
  Else
    ' it's a lot easier in color...
    This_font_header_adr%=Lpeek(Line_a_adr%-460)
    Let Next_font_header_adr%=Lpeek(This_font_header_adr%+84)
    Other_font_data_address%=Lpeek(Next_font_header_adr%+76)
  Endif
  ' the Zero Font is my term for the other (or non_native) system font
  Font%=0
  Font_data_address%(Font%)=Other_font_data_address%
  If Rez%=2
    ' on the monochrome monitor, the 8x8 other system font gives you
    ' 50 lines of print with 8-pixel-high characters, needs good eyes
    Cell_height%(Font%)=8
    Max_line%(Font%)=49
    Ram_line%(Font%)=640
  Else
    ' on the color monitor, the 8x16 system font gives you
    ' 12 lines of print with 16-pixel-high characters, good for bad eyes
    Cell_height%(Font%)=16
    Max_line%(Font%)=11
    Ram_line%(Font%)=2560
  Endif
  ' the One Font is my term for the native system font
  Font_size%(Font%)=1
  Font%=1
  Font_data_address%(Font%)=Lpeek(Font_data_adr%)
  ' only the cell_height varies between the two monitors
  If Rez%=2
    Cell_height%(Font%)=16
  Else
    Cell_height%(Font%)=8
  Endif
  ' everything else is the same
  Max_line%(Font%)=24
  Ram_line%(Font%)=1280
  Font_size%(Font%)=0
  Standing_font%=Font%
Return
Procedure Initialize_font(X%)
  ' place these tabled characteristics of the font
  ' in the Line A Tables for the PRINT command to use
  Dpoke Max_line_adr%,Max_line%(X%)
  Dpoke Ram_line_adr%,Ram_line%(X%)
  Dpoke Cell_height_adr%,Cell_height%(X%)
  Lpoke Font_data_adr%,Font_data_address%(X%)
  If X%>1
    Alt_font%=X%
  Endif
  ' adjust the screen for each font used
  @Check_screen(X%)
Return
Procedure Degas_loader
  ' holder for the loaded data
  Dega$=String$(2050,0)
  ' I have since discovered that many PD Degas fonts are odd sizes,
  ' either more than 2050 bytes, or less. Loading the long ones will,
  ' of course, crash all this, so you might want to enlarge the
  ' loading string. Best to run them through HUD's FONTEDIT.PRG,
  ' after which they WILL be 2050 bytes long...
  '
  ' as a protection against punching data right on through the end
  ' of the reserved memory area, let's make this string too long...
  Dega$=String$(3000,0)
  Showm
  Clr Filegot%
  ' save the program path$
  Old_path$=Path$
  ' mask for font files
  Path$=Dr$+D_path$+"*.FNT"
  Fileselect Path$,"",L_font$
  ' reset the program path$
  Path$=Old_path$
  If Len(L_font$)>1
    Bload L_font$,Varptr(Dega$)
    Filegot%=1
  Else
    Goto Fontout
  Endif
  ' if there are already ten fonts loaded, replace the tenth with the new one
  If Hi_font%>9
    Hi_font%=9
  Endif
  ' before loading, we repeat the transfer of the now approriately
  ' sized system font into the font_data, so we have characters 128-255.
  ' this time they'll be the right size for the font, of course.
  Bmove Font_data_address%(Font%),Varptr(Font$(Hi_font%)),4096
  ' the loaded font is always the same size as the current font
  Font_size%(Hi_font%+2)=Font_size%(Font%)
  ' assign the new font its program font_handle
  Font%=Hi_font%+2
  ' set the font_data_address
  Font_data_address%(Font%)=Varptr(Font$(Hi_font%))
  Defmouse 2
  ' the DEGAS font format must first be translated into the GEM font format!
  ' in GEM, the font is a raster image: all first scan lines of all
  ' characters, followed by all second scan lines of all characters, etc.
  ' in DEGAS, each character is saved: all the scan lines for A, followed
  ' by all the scan lines for B, etc. These routines re-leave to GEM format.
  ' (in GFA3: BYTE{} is much faster than PEEK() and POKE!)
  ' these routines ignore the enabling switch for half-height fonts
  ' in the DEGAS format. If the cell_height is 8, every other line is
  ' loaded into the font_data, but the results may not be pleasing
  ' unless the font was carefully designed to work both ways...
  '
  ' it would be easy to modify this routine to load some GEM fonts;
  ' all you would have to do is skip this re-leaving process! However,
  ' those GEM fonts would have to have the following characteristics:
  ' cell_height of 16, width 8, equal-spacing, full set of characters 0-127.
  '
  ' this first routine is for cell_height=16
  If (Rez%=2 And Font_size%(Font%)=0) Or (Rez%=1 And Font_size%(Font%)=1)
    J%=0
    Repeat
      K%=0
      Repeat
        ' inserts the DEGAS font_data into the GEM font_data format
        Poke Varptr(Font$(Hi_font%))+K%*256+J%,Peek(Varptr(Dega$)+K%+J%*16)
        Inc K%
      Until K%=16
      Inc J%
    Until J%=128
    Cell_height%(Font%)=16
    If Rez%=2
      Max_line%(Font%)=24
      Ram_line%(Font%)=1280
    Else
      Max_line%(Font%)=11
      Ram_line%(Font%)=2560
    Endif
  Else
    ' the second routine is for cell_height=8
    J%=0
    Repeat
      K1%=0
      K2%=0
      Repeat
        Poke Varptr(Font$(Hi_font%))+K1%*256+J%,Peek(Varptr(Dega$)+K2%+J%*16)
        Inc K1%
        ' skips over a line of font_data, reading only every other line
        Inc K2%
        Inc K2%
      Until K2%=16
      Inc J%
    Until J%=128
    Cell_height%(Font%)=8
    If Rez%=2
      Max_line%(Font%)=49
      Ram_line%(Font%)=640
    Else
      Max_line%(Font%)=24
      Ram_line%(Font%)=1280
    Endif
  Endif
  Defmouse 0
  '
  ' Now, if you really want to live dangerously...
  ' you could change the native GEM system font data,too,
  ' that is, the font that is used for alerts, fileselects, etc.
  ' This is also the font that is used by GFA's TEXT command, so
  ' that replacing it with a DEGAS font would allow the new font
  ' to be manipulated using the GFA DEFTEXT command, so that you could
  ' dash in, replace it, use it with the TEXT command, then slap the
  ' system font back in place (to avoid later embarassment).
  ' It is the font whose font header address is found 460 bytes below
  ' the Line_a_address; unfortunately, the font data itself remains
  ' in ROM, so we can't just BMOVE the data to that address! Think of
  ' the crashes we could have if we could write to the ROM! Wow!
  ' At any rate, the font whose header address is at Line_a-460 bytes
  ' is the font that GEM uses and that GFA uses for the TEXT command.
  ' First, we save the ROM addresses (only once --- never again)
  '  If Never_again%=0
  '  ' the address of the font data is 76 bytes deep into the header...
  '    Adr%=Lpeek(L~a-460)+76
  '    ' we'll need to be able to restore the ROM address on exit
  '    Restorer%=Lpeek(Adr%)
  '    Never_again%=1
  ' Endif
  ' this will insert the font data of the most recently loaded font
  ' If Never_again%>0
  '   ' if it's the right size (same as the native system font)
  '   If Font_size%(Font%)=0
  '     Lpoke Adr%,Font_data_address%(Font%)
  '   Endif
  ' Endif
  ' If you wanted to preserve the new GEM font, you have to be able to
  ' keep the font data in a reserved area protected from other programs,
  ' that is, in a memory-resident accessory, like FONTRIX.ACC does...
  ' Or, you could use MALLOC to protect the data from GEM, if you
  ' can get it to work, that is. Interesting crashes result.
  ' However, you could easily use this code to change the GEM font
  ' in a program and then restore the system font on program exit,
  ' thus having a custom font for each program...
  '
  ' ok, let's get back to what we were doing in the first place...
  '
  ' increment the index for the next font to be loaded
  Add Hi_font%,1
  Fontout:
  Hidem
Return
'
' ****************************************************************************
' *                          SECTION 5: WINDOW ROUTINES                      *
' ****************************************************************************
'
' Basically, the text window is simple: you tell the shifter chip how far
' down the screen to start the window [Windtop%(Window%)] and you keep track
' of how many lines the window area contains [Windhi%(Window%)+1]. The rest
' is mere housekeeping. The window ledger_line is not included in the count
' of window lines in Windhi%()+1, but must be kept track of separately...
'
' initial window set-up for two equal-size windows
Procedure Set_windows
  Windhi%(0)=((Max_line%(Font%)-3)\2)
  Windhi%(1)=((Max_line%(Font%)-3)\2)
  ' the top window (window 1) starts at the top of the screen
  Windtop%(1)=0
  ' the bottom window (window 0) starts below its ledger_line
  ' the ledger-line is not included in the count of window lines
  Windtop%(0)=(Windhi%(0)+2)*Ram_line%(Font%)
Return
Procedure Set_up_windows
  ' no margin possible in only one or several of multiple windows,
  ' since whole screen is affected by the shift
  Dpoke Shifter_adr%,0
  ' clears the screen except for menu ledger_line and leaves the cursor there
  Print At(80,Max_line%(Font%));Chr$(27);"d";
  ' start with the document split at the same point in both windows
  Windex%(0)=Index%
  Windex%(1)=Index%
  @Set_windows
  Window%=0
  @Window(Window%,Windex%(Window%))
  Window%=1
  @Window(Window%,Windex%(Window%))
Return
Procedure Wind_title(Z%)
  ' switch to system font
  Lpoke Font_data_adr%,Font_data_address%(1-Font_size%(Font%))
  ' print the window ledger_line in inverse and return
  Print At(1,Dpeek(Max_line_adr%)+1);Inv$;String$(80,32);Chr$(13);
  ' active window indicated with arrow marker "==>"
  If Z%=Active_window%
    Print " ==>  WINDOW: ";Z%+1;"   FILE: ";File$;"   LINE: ";Windex%(Z%);"/";Top%-1;" <== ";Norm$;
  Else
    Print " WINDOW: ";Z%+1;"   FILE: ";File$;"   LINE: ";Windex%(Z%);"/";Top%-1;Norm$;
  Endif
  ' switch to current font
  Lpoke Font_data_adr%,Font_data_address%(Font%)
Return
Procedure Unwindow
  ' keep the your place in the text that was shown in the active window
  Index%=Windex%(Window%)
  ' reset the screen for full height
  Dpoke Max_line_adr%,Max_line%(Font%)
  ' reset the window flag
  Windows!=False
  ' reset the menu ledger_line
  Clr Which%
  ' restore any margin selected before there were two windows
  Dpoke Shifter_adr%,Margin%
  ' reprint the screen
  @Tidy
  @Clean_up
Return
Procedure Clear_window(Z%)
  ' binary move of blank memory to clear only the window area
  If View%=0
    Bmove Varptr(Eraser$),Page2%+Windtop%(Z%),(Windhi%(Z%)+1)*Ram_line%(Font%)
  Else
    Bmove Varptr(Eraser$),Physical%+Windtop%(Z%),(Windhi%(Z%)+1)*Ram_line%(Font%)
  Endif
Return
Procedure Window(X%,Y%)
  ' maintain invisible updating
  If View%=0
    @Set_up
    Bmove Page1%,Page2%,32000
    Void Xbios(5,L:Page2%,L:Logical%,-1)
  Endif
  ' set up the Line A Tables for this window
  Dpoke Shifter_adr%,Windtop%(X%)
  Dpoke Max_line_adr%,Windhi%(X%)
  ' clear the window
  @Clear_window(X%)
  ' home the cursor
  @Home
  ' print the text in the window area
  T%=Dpeek(Max_line_adr%)
  If Y%>Top%-T%+1
    Windex%(X%)=Top%-T%+1
  Endif
  If Y%<1
    Windex%(X%)=1
  Endif
  Y%=Windex%(X%)
  ' notice that we MUST NOT print carriage returns in multiple windows
  If T%-1+Y%=>Top%
    I%=0+Y%
    Repeat
      Print At(1,I%-Y%+1);Left$(Type$(I%),Len(Type$(I%))-2);
      Inc I%
    Until I%>Top%
  Else
    I%=0+Y%
    Repeat
      Print At(1,I%-Y%+1);Left$(Type$(I%),Len(Type$(I%))-2);
      Inc I%
    Until I%>T%+Y%
  Endif
  ' set the window one line larger...
  Dpoke Max_line_adr%,Windhi%(X%)+1
  ' ...so we can print the window ledger_line...
  @Wind_title(X%)
  ' ...then reset it.
  Dpoke Max_line_adr%,Windhi%(X%)
  ' if we're printing invisibly, update the monitor display
  If View%=0
    Sget Patch$
    Void Xbios(5,L:Logical%,L:Page1%,-1)
    Vsync
    Sput Patch$
    Patch$=""
  Endif
Return
'
' ****************************************************************************
' *                           SECTION 6: PRINT ROUTINES                      *
' ****************************************************************************
'
Procedure Print
  Clr P_done%
  Clr P_count%
  Showm
  Repeat
    @Alert(3,"  |Align Your Printer|  to Top of Form|  and Turn it ON.|  ",1," OK ",Dummie%)
    ' note: we have to re-print the screen to remove the alert box when
    ' original rez=0 and current rez=1, just like GFA2's editor doesn't do
    @Screen_print
    ' make sure the dummie turned the printer on
    If Out?(0)=0
      ' give him repeat chances to turn it on...
      If P_count%>0
        @Alert(2,"  |Abort This Print|  Operation?|  ",2," No | Yes ",Dummie%)
        If Dummie%=2
          P_done%=1
          P_skip%=1
        Endif
      Else
        @Alert(3,"  |Your Printer| Is NOT On.|  ",1," OK ",Dummie%)
      Endif
      @Screen_print
      Inc P_count%
    Else
      ' this SBR used by PRINT and SAVE
      @Double_duty
      P_done%=1
    Endif
  Until P_done%>0
  Defmouse 0
  Hidem
  @Yellow_off
  ' give the user a chance to formfeed the tractor
  If P_skip%=0
    Lprint Chr$(13);
    @Alert(2,"  |Insert Formfeed?|  ",1," Yes | No ",Dummie%)
    If Dummie%=1
      Lprint Chr$(12);
    Endif
  Else
    P_skip%=0
  Endif
  Index%=Hindex%
  If Black_flag%=1 And Rez%<>2
    Setcolor 1,&H770
  Endif
  @Screen_print
Return
' this sets the highlight color for a selected block:
' a yellow highlight when the background color is white and
' a medium blue highlight when the background color is black
Procedure Yellow_on
  If Rez%<>2
    If Black_flag%=1
      Setcolor 1,&H5
    Endif
    Print Chr$(27);"c1";
  Endif
Return
Procedure Yellow_off
  If Rez%<>2
    Print Chr$(27);"c0";
  Endif
Return
' self-explanatory, don't you think?
Procedure Perf_skip
  For L%=1 To 3
    Lprint
  Next L%
Return
'
' ****************************************************************************
' *                            SECTION 7: SAVE ROUTINES                      *
' ****************************************************************************
'
Procedure Save
  @Double_duty
  @Yellow_off
  If Black_flag%=1 And Rez%<>2
    Setcolor 1,&H770
  Endif
  Index%=Hindex%
  @Screen_print
Return
Procedure Mark_line(Ml%)
  Mck%=Ml%-Index%+1
  If Mck%=>1 And Mck%=<Max_line%(Font%)
    Print At(1,Mck%);Inv$;Left$(Type$(Ml%),Len(Type$(Ml%))-2);Chr$(32);Norm$;
  Endif
Return
Procedure Unmark_line(Ml%)
  Mck%=Ml%-Index%+1
  If Mck%=>1 And Mck%=<Max_line%(Font%)
    Print At(1,Mck%);Norm$;Left$(Type$(Ml%),Len(Type$(Ml%))-2);Chr$(32);
  Endif
Return
'
' this routine works with both PRINT and SAVE routines:
' while it may be confusing following the trail of two FUNCTIONS
' through the code, it saves duplication of several Kb's of code
'         FUNCTION=19=SAVE         FUNCTION=16=PRINT
'
Procedure Double_duty
  ' save the index of the existing memo line
  Owch%=Which%
  ' set a function for print or save
  Function%=C%
  ' save the top line of the existing screen for return when done
  Hindex%=Index%
  ' querry all or part?
  @Alert(2,"  |Entire Document|Or Marked Block?|  ",1,"Block| All ",Complete%)
  ' querry for perf-skip if function is print
  Clr Perfer%
  If Function%=16
    @Alert(2,"  |Set Perf-Skip? |  ",1," ON | OFF ",Perfer%)
  Endif
  ' reprint the screen after every alert because GEM won't clear it in
  ' low resolution switched to medium
  @Screen_print
  ' first half of this big IFfie is for the entire document option
  If Complete%=2
    ' starting index is beginning of file
    Stindex%=1
    ' finishing index is end of file
    Fnindex%=Top%
    ' for saving the file to disc
    If Function%=19
      Showm
      Fileselect Path$,"",Saver$
      If Len(Saver$)>1
        Defmouse 2
        Open "O",#1,Saver$
        ' this reprints the screen with lines highlighted in color or dotties
        @Screen_setup
        @Yellow_off
        ' this adds the zero-th type$ to the file, because ascii=>1stWord
        ' conversion needs this line to set the WP flag for 1stWord
        ' otherwise, you just get an extra CR at the head of the file
        Print #1,Type$(0);
        ' this does the real work
        @File_saver
      Endif
    Endif
    ' for printing the file
    If Function%=16
      ' skip three lines
      If Perfer%=1
        @Perf_skip
      Endif
      ' again, set up the screen with color highlight lines or dotties
      @Screen_setup
      ' this does the real work
      @File_print
    Endif
    Defmouse 0
    Hidem
    ' this JMP skips over all the rest of this procedure
    ' which is concerned with saving and printing BLOCKS only
    Goto The_bottom
  Else
    ' this option allows the user to mark a block:
    ' PLEASE NOTE: the end-of-block marked line is INCLUDED in the block,
    ' unlike many programs' conventional usage for block-marking in which
    ' the start of the mark is excluded from the block, OK?
    '
    ' put up the memo with block-marking commands
    Which%=4
    @Ledger_line
    ' and an alert to the same effect...
    @Alert(1," <CNTL>+D to Move Marker Down; |  <CNTL>+U to Move Marker Up. |      <CNTL>+A for START; |    <CNTL>+Z for LAST LINE. |  ",1," OK ",Dummie%)
    ' reprint the screen
    @Screen_print
    ' start the marked line at the top of the screen
    Marked_line%=Index%
    @Mark_line(Marked_line%)
    ' look for input
    Repeat
      C$=Inkey$
      If Len(C$)=2
        Cc%=Asc(Right$(C$))
        Key_flag!=True
      Endif
      If Len(C$)=1
        C%=Asc(C$)
      Endif
      ' move the mark down
      If C%=4
        ' unmark the marked line
        @Unmark_line(Marked_line%)
        ' increment the line number to be marked
        Add Marked_line%,1
        ' if it goes off the screen to the bottom...
        If Marked_line%-Index%=>Max_line%(Font%)
          ' scroll the screen first...
          Index%=Marked_line%
          @Screen_print
        Endif
        ' then mark the new line
        @Mark_line(Marked_line%)
      Endif
      ' as above, only for moving up
      If C%=21
        @Unmark_line(Marked_line%)
        Sub Marked_line%,1
        If Marked_line%<Index%
          Index%=Marked_line%
          @Screen_print
        Endif
        @Mark_line(Marked_line%)
      Endif
      ' set the starting index, with one bell to confirm to user
      If C%=1
        Stindex%=Marked_line%
        St_set%=1
        Print Chr$(7);
      Endif
      ' set the finishing index, with two bells to confirm to user
      If C%=26
        Fnindex%=Marked_line%
        Fn_set%=1
        Print Chr$(7);
        Pause 8
        Print Chr$(7);
      Endif
      ' if things get screwed up, start all over again...
      If Stindex%>Fnindex% And Fn_set%=1 And St_set%=1
        @Alert(3," |     Try Again! | Re-Mark the Block! | ",1,"Sorry",Dummie%)
        Clr St_set%
        Clr Fn_set%
        Clr Stindex%
        Clr Fnindex%
        @Screen_print
        @Mark_line(Marked_line%)
      Endif
      ' if a two-byte key message has been sent,
      ' read it with the same double-key procedure
      ' used by the main program, and move the mark along with it
      If Key_flag!=True
        @Double_key
        @Unmark_line(Marked_line%)
        Add Marked_line%,Offset%
        @Mark_line(Marked_line%)
        Clr Offset%
        Key_flag!=False
      Endif
      ' clear the trigger variables to prevent repetition
      Clr C%
      Clr Cc%
      ' until you get it right!
    Until Fn_set%=1 And St_set%=1
  Endif
  ' set up the screen to start with the beginning of the block
  Index%=Stindex%
  ' reprint the screen with highlight color or dotties
  @Screen_setup
  Clr St_set%
  Clr Fn_set%
  Defmouse 2
  ' saving a block as a file
  If Function%=19
    Showm
    Fileselect Path$,"",Saver$
    Hidem
    If Len(Saver$)>1
      Open "O",#1,Saver$
      @File_saver
    Else
      Goto The_bottom
    Endif
  Endif
  Pindex%=Stindex%
  Twofer!=False
  If Function%=16
    @File_print
  Endif
  The_bottom:
  @Yellow_off
  Which%=Owch%
  @Ledger_line
  Clr Function%
Return
' printing the file to line device or disc is pretty routine stuff, ok?
' but the visual display is not so simple
' the purpose of the exercise is to maintain
' the printing of lines in highlight color or dotties,
' scrolling the screen up as each line is sent to the device,
' if the screen is scrollable, and if it isn't, then
' we unhighlight or de-dottie it as it is sent off!
' that's, well, less simple... four routines to get it done:
'
' first of all, the actual printer routine...
Procedure File_print
  Clr Control%
  Odd!=False
  Deffill 1,2,1
  @Yellow_off
  For I%=Stindex% To Fnindex%
    Lprint Type$(I%);
    ' this routine does the highlights
    @Highlight(I%)
    ' six line perf-skip
    If (I%-Pindex%) Mod 60=0 And Twofer!=True
      If Perfer%=1
        @Perf_skip
        @Perf_skip
      Endif
    Endif
    Twofer!=True
    P$=Inkey$
    Exit if Asc(P$)=16
  Next I%
  ' unhighlight the last one..
  @Highlight(I%)
  P_done%=1
Return
' the second, essentially the same as the file printing routine
Procedure File_saver
  Clr Control%
  Odd!=False
  Deffill 1,2,1
  @Yellow_off
  For I%=Stindex% To Fnindex%
    Print #1,Type$(I%);
    ' this routine does the highlights
    @Highlight(I%)
  Next I%
  ' unhighlight the last one..
  @Highlight(I%)
  Close #1
Return
' here's where it gets interesting:
' now, this sets up an initial screen with highlight color or dotties
Procedure Screen_setup
  ' reprint the screen
  @Screen_print
  ' turn on the highlight or the dotties
  @Yellow_on
  Deffill 1,2,1
  ' figure out where to place the (invisible) cursor
  If Index%=Stindex%
    @Home
  Else
    Print At(1,Stindex%-Index%+1);
  Endif
  ' calculate the print offset, if any
  Profset%=Stindex%-Index%
  ' print the highlit lines
  I%=Stindex%
  Repeat
    Print Type$(I%);
    If Rez%=2
      Graphmode 2
      Pbox 0,(I%-Stindex%+Profset%)*Cell_height%(Font%),(Len(Type$(I%))-1)*8,(I%-Stindex%+1+Profset%)*Cell_height%(Font%)
      Graphmode 1
    Endif
    Inc I%
    Exit if I%>Fnindex%
  Until I%=>T%+Index% Or I%>Top%
Return
' and this does the actual highlighting and unhighlighting after screen_setup
' it is indexed to the actual type$ number being printed (as its parameter)
Procedure Highlight(H%)
  ' it's different for the two kinds of highlighting
  ' dotties have to slapped over after the line is printed,
  ' but color has to be turned on before the line is printed
  If Rez%=2
    Prindex%=H%
    ' scroll if you can...
    If Prindex%=<Top%-T% And Prindex%=<Fnindex%
      ' odd! is a first-time skip variable. I called it odd because it is...
      If Odd!=True
        Add Index%,1
      Endif
      Bmove Xbios(2)+Ram_line%(Font%),Xbios(2),Affected_screen%
      Print At(1,Max_line%(Font%));Chr$(27);"K";
      Print At(1,Max_line%(Font%));Type$(Prindex%+Max_line%(Font%));
      ' if the inserted line is part of the block, then highlight it
      If Prindex%+Max_line%(Font%)=<Fnindex%
        Graphmode 2
        Pbox 0,(Max_line%(Font%)-1)*Cell_height%(Font%),(Len(Type$(Prindex%+Max_line%(Font%)))-1)*8,Max_line%(Font%)*Cell_height%(Font%)
        Graphmode 1
      Endif
      Odd!=True
    Else
      ' we have to determine if the screen has ever scrolled in this pass
      If Odd!=False
        ' if the screen is unscrollable, un-highlight the line just printed
        Print At(1,Prindex%-Index%);Chr$(27);"K";Type$(Prindex%-1);
        ' important to reset the cursor position!
        Print At(1,Prindex%-Index%-1);
      Else
        ' if the screen has scrolled, the type$ to be printed is different
        Print At(1,Prindex%-Index%);Chr$(27);"K";Type$(Prindex%);
        Print At(1,Prindex%-Index%-1);
      Endif
    Endif
  Else
    ' formally, the same as above
    ' the chief difference is that dottie-boxes are calculated from the
    ' TOP of the print-line, and colored lines from the BASELINE of print
    Prindex%=H%
    If Prindex%=<Fnindex% And Prindex%=<Top%-T%
      If Odd!=True
        Add Index%,1
      Endif
      Bmove Xbios(2)+Ram_line%(Font%),Xbios(2),Affected_screen%
      Print At(1,Max_line%(Font%));Chr$(27);"K";
      If Prindex%+Max_line%(Font%)<=Fnindex%
        @Yellow_on
      Endif
      Print At(1,Max_line%(Font%));Type$(Prindex%+Max_line%(Font%));
      @Yellow_off
      Odd!=True
    Else
      If Odd!=False
        Print At(1,Prindex%-Index%);Chr$(27);"K";Type$(Prindex%-1);
        Print At(1,Prindex%-Index%-1);
      Else
        Print At(1,Prindex%-Index%);Chr$(27);"K";Type$(Prindex%);
        Print At(1,Prindex%-Index%-1);
      Endif
    Endif
  Endif
Return
'
' ****************************************************************************
' *                         SECTION 8: CONVERT ROUTINES                      *
' ****************************************************************************
'
' surprizingly fast conversion between the two formats (well, I was surprized)
Procedure Convert
  Defmouse 2
  Showm
  ' the Flag% is the CNTL key
  If Flag%=0
    ' 1stWord==>Ascii
    ' nothing fancy at first; just put the fixed-space (CHR 32)
    ' in the plces occupied by the word-processing space (CHR 30)
    For I%=1 To Top%
      Ii%=Instr(Type$(I%),Chr$(30))
      While Ii%<>0
        Mid$(Type$(I%),Ii%,1)=Chr$(32)
        Ii%=Instr(Type$(I%),Chr$(30),Ii%+1)
      Wend
    Next I%
    ' you could insert a routine here to remove specific control
    ' characters from a 1stWord word-processing file (markers for font
    ' changes, etc.) if you want to create a purely Ascii file, but
    ' in general the console just ignores them, anyway.
  Else
    ' Ascii==>1stWord
    ' no ruler line is provided because 1stWord will
    ' load the SAVEd file without one just fine. I say
    ' let 1stWord write its own headers...
    '
    ' This marks the file as a WP-flag=TRUE for 1stWord
    Type$(0)=Chr$(31)+Cr$
    ' we're going to have to add an extra line to the end to make this work
    Type$(Top%+1)=Cr$
    For I%=1 To Top%
      ' first we change the CHR 32 to CHR 30...
      Ii%=Instr(Type$(I%),Chr$(32))
      While Ii%<>0
        Mid$(Type$(I%),Ii%,1)=Chr$(30)
        Ii%=Instr(Type$(I%),Chr$(32),Ii%+1)
      Wend
      ' ...then, we look ahead to the next line of text...
      Nl%=Asc(Type$(I%+1))
      ' ...to see if it's the start of a paragraph or tabular matter
      ' or a blank line... (remember, it hasn't been converted yet!)
      If Nl%<>9 And Nl%<>32 And Nl%<>13 And Nl%<>10
        ' 1stWord wants every line in a paragraph to end with a (CHR 30) space
        If Mid$(Type$(I%),Len(Type$(I%))-2,1)<>Chr$(30)
          Type$(I%)=Left$(Type$(I%),Len(Type$(I%))-2)+Chr$(30)+Cr$
        Endif
      Else
        ' except the last line of a paragraph, which must not!
        While Mid$(Type$(I%),Len(Type$(I%))-2,1)=Chr$(30)
          Type$(I%)=Left$(Type$(I%),Len(Type$(I%))-3)+Cr$
        Wend
      Endif
    Next I%
    ' this produces a 1stWord WP file that can be reformatted by 1stWord
  Endif
  Defmouse 0
  Hidem
  @Screen_print
Return
'
' ****************************************************************************
' *                             SECTION 9: TAB ROUTINE                       *
' ****************************************************************************
'
' The console has a default TAB of eight spaces supplied by character 9.
' Since I haven't been able to find where this value is stored for the console
' driver to use, I've been unable to figure out how to reset the TAB_value
' directly to the console. Any suggestions for a likely POKE are welcome.
' Meanwhile, this routine will strip the chr$(9) out of the file the first
' time through, replacing them with chr$(1) + a string of spaces. The next time
' through only string of spaces is changed. A possible confusion can occur
' if you save these de-tabbed modified files and load them to a word-processor!
' (depending on its feelings toward embedded control characters...)
'
Procedure Tabber
  @Font_check_in
  @New_line
  If Tb%<>0 Or Tabs!=True
    Otb%=Tb%
  Endif
  If Tb%=0 And Tabs!=False
    Print " <TAB> default eight spaces; how many to assign? ";
    Temp_flag%=0
  Else
    Print " <TAB> is currently ";Str$(Otb%);" spaces; how many to assign? ";
    Clr Tb%
    Temp_flag%=1
  Endif
  Tb$=""
  Tbac$=""
  Repeat
    Tba$=Inkey$
    If Asc(Tba$)>47 And Asc(Tba$)<58
      Tbac$=Tbac$+Tba$
      Tb%=Val(Tbac$)
      Print At(52,Max_line%(Font%)+1);"TAB=";Tbac$;" Press <Ret> to enter.";
    Endif
    If Asc(Tba$)=8 And Len(Tbac$)>0
      Tbac$=Left$(Tbac$,Len(Tbac$)-1)
      Tb%=Val(Tbac$)
      Print At(52,Max_line%(Font%)+1);"TAB=";Tbac$;" Press <Ret> to enter. ";
    Endif
    If Asc(Tba$)=27
      Tmp%=Len(Tbac$)
      Tbac$=""
      Tb%=Val(Tbac$)
      Print At(52,Max_line%(Font%)+1);"TAB=";Tbac$;" Press <Ret> to enter.";Spc(Tmp%);
    Endif
  Until Tba$=Chr$(13)
  Print Norm$;
  Showm
  Defmouse 2
  If Temp_flag%=0
    For K%=1 To Top%
      Ii%=Instr(Type$(K%),Chr$(9))
      While Ii%<>0
        Tabs!=True
        Type$(K%)=Left$(Type$(K%),Ii%-1)+Chr$(1)+String$(Tb%,32)+Right$(Type$(K%),Len(Type$(K%))-Ii%)
        Ii%=Instr(Type$(K%),Chr$(9),Ii%+1)
      Wend
    Next K%
  Else
    For K%=1 To Top%
      Ii%=Instr(Type$(K%),Chr$(1))
      While Ii%<>0
        Tabs!=True
        Type$(K%)=Left$(Type$(K%),Ii%)+String$(Tb%,32)+Right$(Type$(K%),Len(Type$(K%))-Ii%-Otb%)
        Ii%=Instr(Type$(K%),Chr$(1),Ii%+1)
      Wend
    Next K%
    Defmouse 0
    Hidem
  Endif
  If Tabs!=False
    Print Chr$(7);
    @New_line
    Print " Sorry! There are no TAB's in this file! ";
    Print Norm$;
    Pause 100
  Endif
  Clr Temp_flag%
  @Font_check_out
  @Clean_up
Return
Procedure New_line
  @Message(Inv$+Space$(80))
  Print At(1,Max_line%(Font%)+1);
Return
' ****************************************************************************
' *                         SECTION 10: SEARCH ROUTINE                       *
' ****************************************************************************
'
' the necessity of dealing with multiple windows makes this
' more than a little messy, and I'm running low on annotation...
'
Procedure Search
  ' set up for the search querry message line
  ' everything in this mess has to be set differently depending on the Windows!
  If Windows!=False
    @Font_check_in
  Else
    Lpoke Font_data_adr%,Font_data_address%(1-Font_size%(Font%))
    Dpoke Max_line_adr%,Dpeek(Max_line_adr%)+1
  Endif
  ' print the querry
  Print At(1,Dpeek(Max_line_adr%)+1);
  @Clear
  Print Inv$;String$(80,32);Chr$(13);" Search String: ";
  ' now let the user input his search$
  Search$=""
  Repeat
    Ss$=Inkey$
    If Ss$=Chr$(27) Or Ss$=Chr$(8) Or Ss$=Chr$(13)
      ' GEM convention: <Esc> to clear
      If Ss$=Chr$(27)
        Search$=""
      Endif
      ' GEM convention: <Backspace> to back up
      If Ss$=Chr$(8) And Len(Search$)>0
        Search$=Left$(Search$,Len(Search$)-1)
      Endif
    Else
      ' else append it to search$
      Search$=Search$+Ss$
    Endif
    Print At(17,Dpeek(Max_line_adr%)+1);Search$;"                             ";
    ' until user presses <Return>
  Until Ss$=Chr$(13)
  Print Norm$;
  If Windows!=False
    Stpt%=Index%
  Else
    Stpt%=Windex%(Window%)
  Endif
  ' guess what GOTTIT! is a flag for...
  Gottit%=0
  Place%=0
  Cnt%=0
  ' this just determines the location of the mid-screen print line
  K3%=(Dpeek(Max_line_adr%)+1)\2
  ' this is for the forward search direction
  If Searches%=0
    ' set the starting point
    If Windows!=False
      K%=Index%
    Else
      K%=Windex%(Window%)
    Endif
    ' do the search
    Repeat
      Place%=Instr(Type$(K%),Search$)
      While Place%<>0
        Add Gottit%,1
        If Windows!=False
          Index%=K%-K3%
        Else
          Windex%(Window%)=K%-K3%
        Endif
        ' this will highlight the search$ in inverse video, when you find it
        If Windows!=False
          @Font_check_out
          @Screen_print
          Print At(1,K%-Index%+1);Left$(Type$(K%),Place%-1);Inv$;Search$;Norm$;Right$(Type$(K%),Len(Type$(K%))-Place%-Len(Search$)+1);
          @Font_check_in
        Else
          Lpoke Font_data_adr%,Font_data_address%(Font%)
          Dpoke Max_line_adr%,Dpeek(Max_line_adr%)-1
          @Window(Window%,Index%)
          Dpoke Max_line_adr%,Dpeek(Max_line_adr%)+1
          Print At(1,K%-Windex%(Window%)+1);Left$(Type$(K%),Place%-1);Inv$;Search$;Norm$;Right$(Type$(K%),Len(Type$(K%))-Place%-Len(Search$)+1);
          Lpoke Font_data_adr%,Font_data_address%(1-Font_size%(Font%))
        Endif
        ' you wanna continue or cancel?
        Print At(1,Dpeek(Max_line_adr%)+1);Inv$;String$(80,32);Chr$(13);" Line ";Str$(K%);" of ";Str$(Top%-1);". Continue Searching? (Any Key but <N> or <n>) ";Norm$;
        ' check the key message
        @Little_key_reader
        Exit if Cnt%=78 Or Cnt%=110
        ' mark a new place and continue...
        Place%=Instr(Type$(K%),Search$,Place%+1)
      Wend
      Exit if Cnt%=78 Or Cnt%=110
      Add K%,1
    Until K%>Top%
    ' calculate lines searched
    Ls%=K%-Stpt%
  Else
    ' this is for the reverse search, just the same but backwards
    If Windows!=False
      K%=Index%+Dpeek(Max_line_adr%)+1
    Else
      K%=Windex%(Window%)+Dpeek(Max_line_adr%)+1
    Endif
    If K%>Top%
      K%=Top%
    Endif
    Repeat
      Place%=Instr(Type$(K%),Search$)
      While Place%<>0
        Add Gottit%,1
        If Windows!=False
          Index%=K%-K3%
        Else
          Windex%(Window%)=K%-K3%
        Endif
        If Windows!=False
          @Font_check_out
          @Screen_print
          Print At(1,K%-Index%+1);Left$(Type$(K%),Place%-1);Inv$;Search$;Norm$;Right$(Type$(K%),Len(Type$(K%))-Place%-Len(Search$)+1);
          @Font_check_in
        Else
          Lpoke Font_data_adr%,Font_data_address%(Font%)
          Dpoke Max_line_adr%,Dpeek(Max_line_adr%)-1
          @Window(Window%,Index%)
          Dpoke Max_line_adr%,Dpeek(Max_line_adr%)+1
          Print At(1,K%-Windex%(Window%)+1);Left$(Type$(K%),Place%-1);Inv$;Search$;Norm$;Right$(Type$(K%),Len(Type$(K%))-Place%-Len(Search$)+1);
          Lpoke Font_data_adr%,Font_data_address%(1-Font_size%(Font%))
        Endif
        Print At(1,Dpeek(Max_line_adr%)+1);Inv$;String$(80,32);Chr$(13);" Line ";Str$(K%);" of ";Str$(Top%-1);". Continue Searching? (Any Key but <N> or <n>) ";Norm$;
        @Little_key_reader
        Exit if Cnt%=78 Or Cnt%=110
        ' notice that this isn't really backward; it searches forward
        ' INSIDE each LINE, then the line is decremented to continue searching
        ' forward through the previous line, going forward backwards... humm
        Place%=Instr(Type$(K%),Search$,Place%+1)
      Wend
      Exit if Cnt%=78 Or Cnt%=110
      Sub K%,1
    Until K%=0
    ' calculate lines searched
    Ls%=Stpt%-K%
  Endif
  If Windows!=False
    @Font_check_in
  Else
    Lpoke Font_data_adr%,Font_data_address%(1-Font_size%(Font%))
  Endif
  Print At(1,Dpeek(Max_line_adr%)+1);Inv$;String$(80,32);Chr$(13);
  ' report results to user
  If Gottit%=0
    Print " ";Str$(Ls%);" lines searched. String NOT FOUND! Any Key to Return...";Norm$;
  Else
    If Cnt%=78 Or Cnt%=110
      Print " Line: ";Str$(K%);" Search aborted at ";Str$(Gottit%);" occurrence(s)! Return? (Any Key but <N> or <n>) ";Norm$;
    Else
      Print " ";Str$(Gottit%);" occurrence(s) of string! Return? (Any Key but <N> or <n>) ";Norm$;
    Endif
  Endif
  @Little_key_reader
  ' clean up this mess
  If Windows!=False
    If Cnt%<>78 And Cnt%<>110
      Index%=Stpt%
      @Clean_up
    Else
      @Ledger_line
    Endif
  Else
    Dpoke Max_line_adr%,Dpeek(Max_line_adr%)-1
    If Cnt%<>78 And Cnt%<>110
      Windex%(Window%)=Stpt%
    Endif
    @Window(Window%,Windex%(Window%))
  Endif
  If Windows!=False
    @Font_check_out
  Else
    Lpoke Font_data_adr%,Font_data_address%(Font%)
  Endif
  '
  '  See, didn't I tell you it was going to be messy?!
  '
Return
Procedure Little_key_reader
  ' read any key
  Repeat
    Cnt$=Inkey$
    Cnt%=Asc(Cnt$)
  Until Cnt$<>""
Return
'
' ****************************************************************************
' *                        SECTION 11: MISCELLANEOUS ROUTINES                *
' ****************************************************************************
'
Procedure Too_long_abort
  Alrt$="    ERROR! FILE TOO LONG!| File Must Be Text File Less|Than "+Ar$+" Bytes With No Lines|  Longer Than 240 Characters!"
  @Abort(Alrt$)
Return
Procedure Non_text_abort
  Alrt$="    ERROR! NON-TEXT FILE!| File Must Be Text File Less|Than "+Ar$+" Bytes With No Lines|  Longer Than 240 Characters!"
  @Abort(Alrt$)
Return
Procedure Long_line_abort
  Alrt$="   ERROR! LINES TOO LONG!| File Must Be Text File Less|Than "+Ar$+" Bytes With No Lines|  Longer Than 240 Characters!"
  @Abort(Alrt$)
Return
Procedure Abort(A$)
  @Alert(3,A$,1,"ABORT",Dummie%)
  Kexit%=1
Return
Procedure Alert(Alert_type%,Alert_text$,Button%,Alert_choice$,Var Alert_choice%)
  Alert Alert_type%,Alert_text$,Button%,Alert_choice$,Alert_choice%
Return
' save the user's desktop palette
Procedure Palette_saver
  For I%=0 To 15
    Userp$=Userp$+Mki$(Xbios(7,I%,-1))
  Next I%
Return
Procedure Data_line
  @Font_check_in
  @New_line
  Print " Line ";Str$(Index%);" of ";Str$(Top%-1);".   ";File$;": ";Str$(Ex%);" bytes. ";Norm$;
  Print Norm$;
  @Font_check_out
Return
'
' ****************************************************************************
' *                           SECTION 12: CLOSE-OUT ROUTINE                  *
' ****************************************************************************
'
Procedure End
  ' in case an error occured with a file channel open
  Close
  ' re-normalize the shifter chip
  Dpoke Shifter_adr%,0
  ' clean the windshield
  @Tidy
  ' recall the rodent
  Showm
  ' restore the system font
  If Font%<>1
    @Initialize_font(1)
  Endif
  '
  ' if you changed the GEM font, too, you BETTER reset this address
  '  If Never_again%>0
  '    Lpoke Adr%,Restorer%
  '  Endif
  '
  ' reset the resolution
  If Rez%<>Original_rez%
    Void Xbios(5,L:-1,L:-1,Original_rez%)
  Endif
  ' reset the colors to user's desktop palette
  Void Xbios(6,L:Varptr(Userp$))
  ' turn the automatic character wrap back on
  Print Over_flow$;
  ' turn the boundary of filled figures back on
  Dpoke Contrl,104
  Dpoke Contrl+6,1
  Dpoke Intin,1
  Vdisys
  ' reset the user's drive
  Chdrive Use_drive%
  ' if there was a goof, we want to know what it was...
  If Err>0
    Fake_err%=Err
    Error Fake_err%
  Endif
  ' I'm outta here...
  Edit
Return
'
' With the addition of a screen editor and keyboard input, this would be a
' reasonable framework for a text editor or word processor. I don't really
' feel like re-programming EMACS from scratch this year, however... Besides,
' it's already been done. I hope ST READER proves useful to you as a tool,
' and that its code is more enlightening than it is confusing!
'
' ****************************************************************************
' *                                                                          *
' *                             S T  R E A D E R                             *
' *                               Version 3.10                               *
' *                                                                          *
' *                               Program Code                               *
' *               © 1990 By Sterling K. Webb, SKWare One, Inc.               *
' *                   P. O. Box 277, Bunker Hill, IL 62014                   *
' *                                                                          *
' *                       GFA BASIC © GFA SYSTEMTECHNIK                      *
' *                                                                          *
' *                                                                          *
' ****************************************************************************
'
'
'
' ****************************************************************************
' *                    SECTION 13: DRIVE SELECTION ROUTINE                   *
' *                    Added at the last minute by request                   *
' *                   Intended to make life easier if you're                 *
' *                    working with ST READER on hard disc                   *
' *                    but reading and writing to a floppy                   *
' ****************************************************************************
'
Procedure Drive_alert
  Dr%=Gemdos(25)+1
  Dr$=Chr$(Dr%+64)+":"
  @Get_dir_path
  @Default_mask
  Path$=Dr$+D_path$+Mask$
  Dra$=" Current Drive: "+Left$(Dr$)+"  | Current Path: "+D_path$+"  | Current Mask: "+Mask$+"  "
  @Alert(1,Dra$,1," OK |Reset",Dummie%)
  If Trick!=False
    @Screen_print
  Else
    @Tidy
  Endif
Return
Procedure Drive
  @Drive_alert
  If Dummie%=1
    Goto Drive_out
  Endif
  ' switch to system font
  @Font_check_in
  ' use the ledger line for input
  @Message(Inv$+No_flow$+Space$(80))
  @Message("==> Press <Ret> for current drive. SET DRIVE NOW: ")
  Repeat
    ' take one character
    Drr$=Inkey$
    If Len(Drr$)=1
      Select Asc(Drr$)
        ' current drive
      Case 13
        Dr%=Gemdos(25)+1
        ' upper case A-P
      Case 65 To 80
        Dr%=Asc(Drr$)-64
        ' lower case a-p
      Case 97 To 112
        Dr%=Asc(Drr$)-96
      Default
        ' notify the screw-ups
        @Message(Space$(80))
        @Message(Chr$(7)+"==> NOT A VALID DRIVE! Press any key to continue... ")
        Repeat
        Until Inkey$<>""
        @Message(Space$(80))
        @Message("==> Press <Ret> for current drive. SET DRIVE NOW: ")
        Clr Dr%
      Endselect
      Select Dr%
      Case 1 To 16
        ' construct drive map as a string
        Map$=Bin$(Bios(10),16)
        ' in GFA2, it works like this:
        ' Map$=Bin$(Bios(10))
        ' While Len(Map$)<16
        '   Map$="0"+Map$
        ' Wend
        ' if it's a connected drive, switch to it, else...
        If Mid$(Map$,17-Dr%,1)="1"
          ' this flag to git outta here
          Dr_flag%=1
          Chdrive Dr%
        Else
          ' notify the screw-ups
          @Message(Space$(80))
          @Message(Chr$(7)+"==> NOT A CONNECTED DRIVE! Press any key to continue... ")
          Repeat
          Until Inkey$<>""
          @Message(Space$(80))
          @Message("==> Press <Ret> for current drive. SET DRIVE NOW: ")
        Endif
      Endselect
    Endif
  Until Dr_flag%>0
  Clr Dr_flag%
  Dr$=Chr$(Dr%+64)+":"
  @Message(Space$(80))
  @Message("==> SELECTED DRIVE: "+Dr$+" ")
  Pause 55
  ' now, allow for setting a directory or nest of directories
  ' as a path for the file search
  Repeat
    Try_again!=False
    @Message(Space$(80))
    @Message(" Press <Ret> for Root (if no path shown). SET PATH NOW: ")
    @Get_dir_path
    Ppac$=Left$(D_path$,Len(D_path$)-1)
    D_path$=Ppac$
    Print Ppac$;
    ' take the user's input
    Repeat
      Pp$=Inkey$
      Select Asc(Pp$)
        ' backspace erase
      Case 8
        If Len(Ppac$)>0
          Ppac$=Left$(Ppac$,Len(Ppac$)-1)
          @Backup
        Endif
        ' escape to clear the path
      Case 27
        Ptmp%=Len(Ppac$)
        Ppac$=""
        For Tp%=1 To Ptmp%
          @Backup
        Next Tp%
        ' append characters to path
      Case 33 To 125
        Print Upper$(Pp$);
        Ppac$=Ppac$+Upper$(Pp$)
      Endselect
      ' until return terminates
    Until Pp$=Chr$(13)
    If Len(Ppac$)=0
      Ppac$="\"
    Endif
    Test$=Ppac$
    If Right$(Test$)<>"\"
      Test$=Test$+"\"
    Endif
    If Exist(Dr$+Test$+"*.*")=True
      Chdir Ppac$
      @Get_dir_path
    Else
      @Message(Space$(80))
      @Message(Chr$(7)+"==> "+Dr$+Test$+" does NOT exist or is EMPTY! Press any key to continue... ")
      Repeat
      Until Inkey$<>""
      Ppac$="\"
      Chdir D_path$
      @Get_dir_path
      Try_again!=True
    Endif
  Until Try_again!=False
  If Right$(D_path$,1)<>"\"
    D_path$=D_path$+"\"
  Endif
  Path$=Dr$+D_path$
  @Message(Space$(80))
  @Message("==> SELECTED DRIVE AND PATH: "+Path$+" ")
  Pause 55
  @Message(Space$(80))
  @Message("==> Press <Ret> to confirm.    SET MASK NOW: ")
  @Default_mask
  Print Mask$;
  Repeat
    Mk$=Inkey$
    Select Asc(Mk$)
      ' backspace erase
    Case 8
      If Len(Mask$)>0
        Mask$=Left$(Mask$,Len(Mask$)-1)
        @Backup
      Endif
      ' escape to clear the mask
    Case 27
      Ptmp%=Len(Mask$)
      Mask$=""
      For Tp%=1 To Ptmp%
        @Backup
      Next Tp%
      ' append characters to mask
    Case 33 To 125
      Print Upper$(Mk$);
      Mask$=Mask$+Upper$(Mk$)
    Endselect
    ' until return terminates
  Until Mk$=Chr$(13)
  @Default_mask
  Path$=Path$+Mask$
  @Message(Space$(80))
  @Message("==> SELECTED: "+Path$+"   Press any key to continue... ")
  Repeat
  Until Inkey$<>""
  ' clear the ledger line
  @Message(Space$(80))
  Drive_out:
Return
Procedure Get_dir_path
  D_path$=Dir$(Dr%)
  D_path$=D_path$+"\"
  Path$=Dr$+D_path$
Return
Procedure Message(A$)
  Print At(1,Max_line%(Font%)+1);A$;
Return
Procedure Backup
  Print Chr$(27);"D";Chr$(32);Chr$(27);"D";
Return
Procedure Default_mask
  If Len(Mask$)=0
    Mask$="*.*"
  Endif
Return
' I thought I might use these somewhere... but I didn't
Procedure Cursor_off
  Print Chr$(27);"f";
Return
Procedure Cursor_on
  Print Chr$(27);"e";
Return